SPACE 2/SPACE - Library 2 - Volume 1.iso/program/177/pascal/eroutine.pas

Pascal/Delphi Source File | 1987-09-15 | 20.5 KB | 765 lines

{$M+}
{$E+}


PROGRAM Erics_Pascal_routines_Module ;

{Modular file started Feb 17,87.}
{modified on March 20, 1987 to add include files.}
{Modified on August 19, 1987 to add shareware info.}

{Copyright 1986 by Eric W. Wedaa}
{4620 E. 17th St. }
{Tucson AZ, 85711}

CONST
{$I GEMCONST.PAS}
{$I d:\epascons.inc}

TYPE
{$I d:\EPasType.inc}
{$I GEMTYPE.PAS}

VAR

      {$I d:\EPas_Var.inc}

{1111111111111111111111111111111111111111111111111111111111}
{1111111111  Subroutines start here   111111111111111111111}
{1111111111111111111111111111111111111111111111111111111111}

{$I GEMSUBS.PAS}

{11111111111111111111111111111111111111111111111111111111}
{11111111  Clear the window 11111111111111111111111111111}
{11111111111111111111111111111111111111111111111111111111}

PROCEDURE Home ;
 BEGIN ;
   HIDE_MOUSE ;
   PAINT_RECT (Xtop, Ytop, Wide, Tall) ;
   SHOW_MOUSE ;
 END ; {procedure Home}

{11111111111111111111111111111111111111111111111111111111}
{11111   Waits for and returns a single key 1111111111111}
{11111111111111111111111111111111111111111111111111111111}

PROCEDURE Get_Key (VAR
     C : CHAR ;
     VAR
        What_Key : INTEGER) ;

VAR
   Event,
   Dummy : INTEGER ;
   Msg_Area : MESSAGE_BUFFER ;

 BEGIN ;
   Event :=  GET_EVENT (E_KEYBOARD ,
        0, 0, 0,
        0,
        FALSE, 0, 0, 0, 0,
        FALSE, 0, 0, 0, 0,
        Msg_Area,
        What_Key,
        Dummy, Dummy, Dummy, Dummy, Dummy) ;
   IF (Event & E_KEYBOARD) <>  0
     THEN C :=  CHR (What_Key MOD 256)
     ELSE C :=  ' ' ;
 END ; {procedure Get Key}

{11111111111111111111111111111111111111111111111111111111}
{11111   Cheks for User cancellation 11111111111111111111}
{11111111111111111111111111111111111111111111111111111111}

FUNCTION Is_Cancel : BOOLEAN ;

VAR
   C : CHAR ;
   Event, What_Key,
   Dummy : INTEGER ;
   Msg_Area : MESSAGE_BUFFER ;

 BEGIN ;
   Event :=  GET_EVENT (E_KEYBOARD|e_timer ,
        0, 0, 0,
        0,
        FALSE, 0, 0, 0, 0,
        FALSE, 0, 0, 0, 0,
        Msg_Area,
        What_Key,
        Dummy, Dummy, Dummy, Dummy, Dummy) ;
   IF (Event & E_KEYBOARD) <>  0
     THEN C :=  CHR (What_Key MOD 256)
     ELSE C :=  ' ' ;
   IF C = CHR (3)
     THEN Is_Cancel := TRUE
     ELSE Is_Cancel := FALSE ;
 END ; {function Is_Cancel}

{11111111111111111111111111111111111111111111111111111111}
{1111111111 Gets the current time for reports. 1111111111}
{11111111111111111111111111111111111111111111111111111111}

PROCEDURE Getsttime (VAR
     Time : STRING) ;

{    Returns the system time in the form of 'HH:MM:SS _M', }
{ where HH is hours, MM is minutes, SS is seconds, and _   }
{ is A or P.                                               }

VAR
   Xl : LONG_INTEGER ;
   Hours, Minutes, Seconds : LONG_INTEGER ;

 BEGIN ;
   Xl :=  CLOCK ;
   Hours :=  Xl DIV 3600 ;
   Minutes :=  ( (Xl MOD 3600) DIV 60) ;
   Seconds :=  ( (Xl MOD 3600) MOD 60) ;

   Time[ 0 ] :=  CHR (11) ;
   Time[ 3 ] :=  ':' ;
   Time[ 6 ] :=  ':' ;
   Time[ 1 ] :=  ' ' ;
   Time[ 9 ] :=  ' ' ;
   Time[ 10 ] :=  'A' ;
   Time[ 11 ] :=  'M' ;
   IF Hours = 0
     THEN
      BEGIN ;
        Time[ 1 ] :=  '1' ;
        Time[ 2 ] :=  '2' ;
      END

     ELSE
      BEGIN ;
        IF Hours >= 12
          THEN Time[ 10 ] :=  'P' ;

        if hours > 12
           then Hours :=  Hours - 12 ;

        IF Hours > 9
          THEN
           BEGIN ;
             Time[ 1 ] :=  '1' ;
             Hours :=  Hours - 10 ;
           END ;
        Time[ 2 ] :=  CHR (Hours + 48) ;
      END ; {of else.}

   Time[ 4 ] :=  CHR ( (Minutes DIV 10) + 48) ;

   IF Minutes >=  10
     THEN Minutes :=  Minutes MOD 10 ;

   Time[ 5 ] :=  CHR (Minutes + 48) ;

   Time[ 7 ] :=  CHR ( (Seconds DIV 10) + 48) ;

   IF Seconds >=  10
     THEN Seconds :=  Seconds MOD 10 ;
   Time[ 8 ] :=  CHR (Seconds + 48) ;
 END ; {procedure GetSTTime.}


{1111111111111111111111111111111111111111111111111111111111111111}
{1111111111111111111111111111111111111111111111111111111111111111}
{1111111111111111111111111111111111111111111111111111111111111111}

PROCEDURE St_Date (VAR
     Date : STRING) ;

TYPE
   Word = INTEGER ;

VAR
   Date_And_Time : LONG_INTEGER ;
   Sys_Date : Word ;
   Sys_Time : Word ;

   Month : INTEGER ;
   Day : INTEGER ;
   Year : INTEGER ;

   Hour : INTEGER ;
   Minute : INTEGER ;
   Second : INTEGER ;

   Sdate : STRING ;
   Stime : STRING ;

   Reply : STRING ;
   Retcd : Word ;

   FUNCTION Get_Datetime : LONG_INTEGER ;
XBIOS (23) ;
 BEGIN ;
   Date_And_Time :=  Get_Datetime ;

   Sys_Date :=  Int (SHR (Date_And_Time, 16) & $0000Ffff) ;

   Month :=  SHR (Sys_Date, 5) & $000F ;
   Day :=  Sys_Date & $001F ;
   Year :=  SHR (Sys_Date, 9) & $003F ;

   Year :=  Year + 80 ;
   date[0]:=chr(8);
   date[3]:='/';
   date[6]:='/';
   if month>9
     then
     Begin;
          month:=month-10;
          date[1]:='1';
     end
     else date[1]:=' ';

   date[2]:=chr(month+48);

   if day>9
     then
     Begin;
          date[4]:=chr((day div 10) +48);
          day:=day mod 10;
     end
     else date[4]:=' ';

   date[5]:=chr(day+48);

   if year>9
     then
     Begin;
          date[7]:=chr((year div 10) +48);
          year:=year mod 10;
     end
     else date[7]:=' ';

   date[8]:=chr(year+48);
 END ;


{11111111111111111111111111111111111111111111111111111111}
{1111Initialize all dialog boxes and load data  111111111}
{11111111111111111111111111111111111111111111111111111111}

PROCEDURE Init (VAR
     My_Window : INTEGER) ;

VAR
   Title : STRING ;

{222222222222222222222222222222222222222222222222222222}
{2222222222  Title Screen        2222222222222222222222}
{222222222222222222222222222222222222222222222222222222}

   PROCEDURE Title_Screen ;

    BEGIN ;
      Home ;
      DRAW_STRING (10, 32, 'EPasUtil / Eric''s Pascal Utilities') ;
      DRAW_STRING  (10, 40,
          'Copyright 1986 by Eric W. Wedaa, All Rights Reserved') ;
      DRAW_STRING (10, 48, '4620 E. 17th ') ;
      DRAW_STRING (10, 56, 'Tucson, Az 85711 ') ;
      DRAW_STRING (10, 64,
          'Portions of this product are Copyright(c) 1986, OSS and CCD.') ;
      DRAW_STRING (10, 72, 'Used by Permission of OSS.') ;
      DRAW_STRING (10, 88,
'    This is a Shareware Program.  If you find it to be of use to you, ') ;
      DRAW_STRING (10, 96,
'feel free to send me a check for my time.  ($25.00 recomended.)') ;
draw_String(10,104,
'I Retain all rights to this program, and ask that it not be distributed');
draw_String(10,112,
'by any "Pay for a Public Domain disk" companies.');
draw_String(10,120,
'Please report any bugs or comments to me.');
      DRAW_STRING (10, 128, 'C.I.S.: 76515,2274    BIX: EWEDAA') ;
      DRAW_STRING (10, 136,
          'You (the USER) are responsible for it''s actions ') ;
      DRAW_STRING (10, 144, 'and it''s output.') ;
      DRAW_STRING (10, 160, ' PLEASE HIT ANY KEY TO CONTINUE ') ;
      SHOW_MOUSE ;
      REPEAT ;
      UNTIL KEYPRESS ;
      Home ;
    END ; {title screen}

{------------------------------------------------------------------}

 BEGIN ;

   DRAW_STRING (10, 40, '  Wait a sec.') ;
   DRAW_STRING (10, 80, '     Loading data...') ;
   G_Blanks := '                                                            ' ;
   G_Blanks :=  CONCAT (G_Blanks, G_Blanks) ;
   G_Blanks := CONCAT (G_Blanks, G_Blanks) ;
   Err_Alerts ;
   Set_Tab_String ;
   Set_Cap_String ;
   Set_Choice_String ;
   Set_Ret_String ;
   Mkdicaps ;
   Mkdichoice ;
   Mkdi_Tabs ;
   Mkdi_Returns ;
   Mkdi_Start ;
   Mkdi_Word ;

   INIT_MOUSE ;
   HIDE_MOUSE ;
   Title :=  ' Eric''s Pascal Utilities by Eric Wedaa Ver 0.13.2 ';
   My_Window :=  NEW_WINDOW (G_ALL, Title, 0, 0, 0, 0) ;
   OPEN_WINDOW (My_Window, 0, 0, 0, 0) ;
   TEXT_STYLE (NORMAL) ;
   WORK_RECT (My_Window, Xtop, Ytop, Wide, Tall) ;
   SET_CLIP (Xtop, Ytop, Wide, Tall) ;
   SET_COLOR (WHITE, 1000, 1000, 1000) ;
   TEXT_COLOR (BLACK) ;
   PAINT_COLOR (WHITE) ;
   DRAW_MODE (1) ;
   PAINT_STYLE (1) ;
   PAINT_OUTLINE (FALSE) ;
   Def_Path :=  'd:\*.PAS' ;
   Title_Screen ;
 END ;


{11111111111111111111111111111111111111111111111111111111}
{11 Overlays the corrected word over the old one. 1111111}
{11111111111111111111111111111111111111111111111111111111}

PROCEDURE Overlay (VAR
     Txt_Line : Max_String ;
     Word : STRING ;
     At : INTEGER) ;
VAR
   X : INTEGER ;

 BEGIN ;
   X :=  0 ;
   REPEAT ;
      Txt_Line[ At + X ] :=  Word[ X + 1 ] ;
      X :=  X + 1 ;
   UNTIL X = LENGTH (Word) ;
 END ; {of Procedure Overlay}


{11111111111111111111111111111111111111111111111111111111}
{11 Gets the last non blank character in a line.  1111111}
{11111111111111111111111111111111111111111111111111111111}

FUNCTION Last_Char (var
   Txt_Line : Max_String ) : CHAR ;
VAR
   X : INTEGER ; {Loop var.}
 BEGIN ;
   X :=  LENGTH (Txt_Line) ;
   WHILE (Txt_Line[ X ] = ' ' )
     AND (X > 1) DO
      X :=  X - 1 ;
   IF (X > 0 )
     THEN Last_Char :=  Txt_Line[ X ]
     ELSE Last_Char :=  ' ' ;

 END ; {of Function Last_Char.}

{11111111111111111111111111111111111111111111111111111111}
{11111 Gets and returns the prior 2 non blank chars. 1111}
{11111111111111111111111111111111111111111111111111111111}

PROCEDURE Prior_Chars ( Position : INTEGER ;
{                        Place to start looking from.           }
     VAR
        Pchar1, {       Second char before. May be blank.       }
        Pchar2 : CHAR ; { First Char before. Will not be blank. }
     VAR
        Txt_Line : Max_String) ;

 BEGIN ;
   Pchar1 :=  ' ' ;
   Pchar2 :=  ' ' ;
   Position :=  Position - 1 ;

   WHILE ( ( Position > 0)
     AND (Txt_Line[ Position ] = ' ') ) DO
      Position :=  Position - 1 ;

   IF Position > 0
     THEN
      BEGIN ;
        Pchar2 :=  Txt_Line[ Position ] ;
        IF Position > 1
          THEN Pchar1 :=  Txt_Line[ Position - 1 ]
          ELSE Pchar1 :=  ' ' ;
      END ;

 END ; {Procedure prior_Chars}


{111111111111111111111111111111111111111111111111111111111111111111}
{1111  Gets and returns the next 2 non blank chars.  11111111111111}
{111111111111111111111111111111111111111111111111111111111111111111}

PROCEDURE Next_Chars (VAR
     Txt_Line : Max_String ;
     Position : INTEGER ;
     VAR
        Nchar1, Nchar2 : CHAR) ;

 BEGIN ;
   Nchar1 :=  ' ' ;
   Nchar2 :=  ' ' ;
   Position :=  Position + 1 ;

   WHILE ( ( Position <=  LENGTH ( Txt_Line ) )
     AND (Txt_Line[ Position ] = ' ') ) DO
      Position :=  Position + 1 ;

   IF Position < LENGTH (Txt_Line)
     THEN
      BEGIN ;
        Nchar1 :=  Txt_Line[ Position ] ;
        Nchar2 :=  Txt_Line[ Position + 1 ] ;
      END

     ELSE IF Position = LENGTH (Txt_Line)
       THEN
        BEGIN ;
          Nchar1 :=  Txt_Line[ Position ] ;
          Nchar2 :=  CHR (0) ;

        END ;
 END ; {Procedure Next_Char}


{11111111111111111111111111111111111111111111111111111111}
{11 Makes Word into all capital letters. 1111111111111111}
{11111111111111111111111111111111111111111111111111111111}

PROCEDURE Make_Caps (VAR
     Word : STRING) ;
VAR
   Position : INTEGER ;

 BEGIN ;
   FOR Position :=  1 TO LENGTH (Word) DO
      IF Word[ Position ] IN [ 'a'..'z' ]
        THEN Word[ Position ] :=  CHR ( ORD ( Word[ Position ] ) - 32) ;
 END ;



{11111111111111111111111111111111111111111111111111111111}
{11  Makes the word 1st letter caps. 11111111111111111111}
{11111111111111111111111111111111111111111111111111111111}

PROCEDURE Make_First (VAR
     Word : STRING) ;
VAR
   Position : INTEGER ;
   Was_Underline : BOOLEAN ;
 BEGIN ;
   Position :=  1 ;
   Was_Underline :=  FALSE ;
   IF Word[ Position ] IN [ 'a'..'z' ]
     THEN Word[ Position ] :=  CHR ( ORD ( Word[ Position ] ) - 32 ) ;
   FOR Position :=  2 TO LENGTH (Word) DO
       BEGIN ;
         IF Word[ Position ] = '_'
           THEN Was_Underline :=  TRUE
           ELSE IF ( (Word[ Position ] IN [ 'a'..'z' ] )
             AND (Was_Underline) )
             THEN
              BEGIN ;
                Word[ Position ] :=  CHR ( ORD ( Word[ Position ] ) - 32) ;
                Was_Underline :=  FALSE ;
              END

           ELSE Was_Underline :=  FALSE ;
       END ;
 END ;

{11111111111111111111111111111111111111111111111111111111}
{1111  Makes the Word all lower case. 1111111111111111111}
{11111111111111111111111111111111111111111111111111111111}

PROCEDURE Make_Lower (VAR
     Word : STRING) ;
VAR
   Position : INTEGER ;

 BEGIN ;
   FOR Position :=  1 TO LENGTH (Word) DO
      IF Word[ Position ] IN [ 'A'..'Z' ]
        THEN Word[ Position ] :=  CHR ( ORD (Word[ Position ] ) + 32) ;
 END ;


{11111111111111111111111111111111111111111111111111111111}
{11 Creates new file names.  1111111111111111111111111111}
{11111111111111111111111111111111111111111111111111111111}

PROCEDURE Make_Tmp (VAR
     From_File, To_File : STRING ;
     Extender : STRING) ;
VAR
   Position : INTEGER ;
 BEGIN ;
   To_File :=  From_File ;
   Position :=  LENGTH (To_File) ;

   IF To_File[ Position - 3 ] = '.'
     THEN To_File[ 0 ] :=  CHR (Position - 4)
     ELSE IF To_File[ Position - 2 ] = '.'
       THEN To_File[ 0 ] :=  CHR (Position - 3)
       ELSE IF To_File[ Position - 1 ] = '.'
         THEN To_File[ 0 ] :=  CHR (Position - 2)
         ELSE IF To_File[ Position ] = '.'
           THEN To_File[ 0 ] :=  CHR (Position - 1) ;
   Position :=  LENGTH (To_File) ;
   To_File[ Position + 1 ] :=  '.' ;
   To_File[ Position + 2 ] :=  Extender[ 1 ] ;
   To_File[ Position + 3 ] :=  Extender[ 2 ] ;
   To_File[ Position + 4 ] :=  Extender[ 3 ] ;
   To_File[ 0 ] :=  CHR (Position + 4) ;

{    Make sure we don't return the same file name.     }
   IF To_File = From_File
     THEN To_File[ 0 ] :=  CHR ( ORD ( To_File[ 0 ] ) - 1 ) ;

 END ; {of procedure Make_tmp.}

{11111111111111111111111111111111111111111111111111111111}
{11 Used by Get Answers.  1111111111111111111111111111111}
{11111111111111111111111111111111111111111111111111111111}

PROCEDURE Strip_Blanks (VAR
     INPUT : STRING) ;
VAR
   Y, X : INTEGER ; {Loop variables.}

 BEGIN ;
{strip trailing}
   X :=  ORD (INPUT[ 0 ] ) ;
   WHILE (X > 0)
     AND (INPUT[ X ] = ' ') DO
      BEGIN ;
         INPUT[ 0 ] :=  CHR ( X - 1 ) ;
         X :=  X - 1 ;
      END ; {While loop.}
{Strip leading}
   X :=  LENGTH (INPUT) ;
   WHILE ( INPUT[ 1 ] = ' ' )
     OR ( INPUT[ 1 ] = '0' )
     AND ( X > 0 ) DO
      BEGIN ;
         FOR Y :=  1 TO ( X - 1 ) DO
            INPUT[ Y ] :=  INPUT[ Y + 1 ] ;
         INPUT[ 0 ] :=  CHR (X - 1 ) ;
         X :=  X - 1 ;
      END ; {of while loop.}
 END ; {of procedure Strip blanks}


{11111111111111111111111111111111111111111111111111111111}
{1111   Makes a standard page head for reports.   1111111}
{11111111111111111111111111111111111111111111111111111111}

PROCEDURE Make_P_Head (VAR
     Page_Head : Max_String) ;

VAR
   Time, {             What time is it?}
   Date : STRING ; {   What's the date?}

 BEGIN ;
   Getsttime (Time) ;
   St_Date (Date) ;
   Page_Head :=  CONCAT ('{>>>>>> ', Time, ' Page:001 ', Date, ' ',
        From_File, ' <<<<<< }') ;

   IF (LENGTH (Page_Head) > 80 ) {Trim it if needed so it will fit.}
     THEN DELETE (Page_Head, 31, LENGTH (Page_Head) - 80) ;
 END ; {of procedure Make_P_head.}


{11111111111111111111111111111111111111111111111111111111}
{111  Increases the program line number counter by 1. 111}
{11111111111111111111111111111111111111111111111111111111}

PROCEDURE Increase_Number (VAR
     Number : STRING) ;

VAR
   Done : BOOLEAN ; { Are we done changing it yet?               }
   POS : INTEGER ; {  Which position are we looking at/changing? }

 BEGIN ;
   POS :=  6 ;
   Done :=  FALSE ;
   WHILE (NOT Done )
     AND (POS > 0) DO
      BEGIN ;
         IF ( Number[ POS ] = ' ') {blank.}
           THEN
            BEGIN ;
              Number[ POS ] :=  '1' ;
              Done :=  TRUE ;
            END

{ of number[pos]=' '.}
           ELSE IF (Number[ POS ] < '9')
             THEN
              BEGIN ;
                Done :=  TRUE ;
                Number[ POS ] :=  CHR (ORD (Number[ POS ] ) + 1) ;
              END

{ofnumber[pos]<>' ' and < '9'.}
             ELSE
              BEGIN ;
                Number[ POS ] :=  '0' ;
                POS :=  POS - 1 ;
              END ; {of Number[pos] ='9'.}
      END ; {While not done DO.}
 END ; {Procedure Increase_Line}




{222222222222222222222222222222222222222222222222222222222222222222}
{2222  Determines if this line is where we want to start. 222222222}
{222222222222222222222222222222222222222222222222222222222222222222}

   PROCEDURE Should_It_Be_On (var
          Txt_Line : Max_String ;
        Number,
        Line_Start, Word_Start : STRING ;
        Literal, Comment1, Comment2,
        Is_Line, Is_Word : BOOLEAN ; {See above routine. ^^^^}
        VAR
           On : BOOLEAN) ; {Do we turn it on at this line?   }
   VAR
      Next, Start : INTEGER ;
      Word : STRING ;

    BEGIN ;
      Next :=  1 ;
      Start :=  0 ;
      IF Is_Line
        THEN
         BEGIN ;
           IF Number = Line_Start
             THEN On :=  TRUE ;
         END ;
        IF Is_Word
          THEN
           BEGIN ;
             Next :=  1 ;
             Start :=  0 ;
             Word :=  '' ;
             Next_Word (Txt_Line, Word, Start, Next, Literal,
                  Comment1, Comment2) ;
             IF (Word = 'procedure')
               OR (Word = 'function')
               THEN
                BEGIN ;
                  Next_Word (Txt_Line, Word, Start,
                       Next, Literal, Comment1,
                       Comment2) ;
                  IF Word = Word_Start
                    THEN On :=  TRUE ;
                END ;
           END ;

    END ; {of Procedure should it be on.}




{11111111111111111111111111111111111111111111111111111111}
{11= looks for word in the list of known words.   111111=}
{11111111111111111111111111111111111111111111111111111111}

PROCEDURE In_List (Word : STRING ; {The word we're looking for.}
     VAR
        Word_Type : CHAR) ; {What kind of word is it.           }

{    This FN checks to see if Word is included in the array of special}
{ words.  If it is, it puts the type of word into Word_Type, and      }
{ returns a TRUE, Otherwise, it returns a false, and word_Type is set }
{ to 8.                                                               }

VAR
   Position, {position in the array we're looking at.            }
   Increment : INTEGER ; {How much we change the position by.    }

 BEGIN ;

   Position :=  Known_Words DIV 2 ;
   Increment :=  Known_Words DIV 4 ;
   Word_Type :=  '8' ;

   WHILE ( ( Increment >=  1 )
     AND ( Word <>  List[ Position ] ) ) DO
      BEGIN ;
         IF Word > List[ Position ]
           THEN Position :=  Position + Increment
           ELSE Position :=  Position - Increment ;
         Increment :=  Increment DIV 2 ;
      END ; {While}

   IF Word = List[ Position ]
     THEN Word_Type :=  Kind[ Position ]
     ELSE
      BEGIN ; {Else}
        IF Word < List[ Position ]
          THEN
           BEGIN ;
             WHILE ( (Word < List[ Position ] )
               AND ( Position > 1) ) DO
                Position :=  Position - 1 ;
             IF Word = List[ Position ]
               THEN Word_Type :=  Kind[ Position ] ;
           END

          ELSE
           BEGIN ;
             WHILE ( (Word > List[ Position ] )
               AND (Position < Known_Words ) ) DO
                Position :=  Position + 1 ;
             IF Word = List[ Position ]
               THEN Word_Type :=  Kind[ Position ] ;
           END ;
      END ;
 END ; {Procedure In_List}


{11111111111111111111111111111111111111111111111111111111}
{1111 Clears all Form Feeds from the text line.  11111111}
{11111111111111111111111111111111111111111111111111111111}

Procedure Clear_Form_Feed (var
     txt_line:max_String);
var
x, position:integer;
begin;
     position:=pos(chr(12),txt_line);
     while Position>0 do
      begin;
          for x:= position to ord(txt_line[0]) do
               txt_line[x]:=txt_line[x+1];
          txt_line[0]:=chr( ord(txt_line[0]) -1);
          position:=pos(chr(12),txt_line);
      end;{of while.}
end;{of procedure clear form feed. }



begin;
end.